home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0021_PALETTE.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  7KB  |  235 lines
  1. { FD>  Hey Greg, do you think you could tell me how to access
  2.  FD> Mode-X, preferably the source, if it's no trouble.... :)
  3.  
  4. not a problem....  Mostly I do Graphics and stuff With C, but when it all comes
  5. down to it, whether you use Pascal or C For the outer shell the main Graphics
  6. routines are in Assembler (For speed) or use direct hardware port access
  7. (again, For speed).
  8. The following is a demo of using palette scrolling techniques in Mode 13h (X)
  9. to produce a flashy "bouncing bars" effect often seen in demos:
  10. }
  11.  
  12. Program PaletteTricks;
  13. { Speccy demo in mode 13h (320x200x256) }
  14.  
  15. Uses Crt;
  16.  
  17. Const CGA_CharSet_Seg = $0F000;     { Location of BIOS CGA Character set }
  18.       CGA_CharSet_ofs = $0FA6E;
  19.       CharLength      = 8;          { Each Char is 8x8 bits,  }
  20.       NumChars        = 256;        { and there are 256 Chars }
  21.       VGA_Segment     = $0A000;     { Start of VGA memory     }
  22.       NumCycles       = 200;        { Cycles/lines per screen }
  23.       Radius          = 80;
  24.  
  25.       DispStr         : String =    ' ...THIS IS A LITTLE '+
  26.       'SCROLLY, DESIGNED to TEST SOME GROOVY PASCAL ROUTinES...'+
  27.       '                                                        ';
  28.  
  29.       { Colours For moving bars... Each bar is 15 pixels thick }
  30.       { Three colours are palette entries For RGB values...    }
  31.       Colours : Array [1..15*3] of Byte =
  32.                  (  7,  7, 63,
  33.                    15, 15, 63,
  34.                    23, 23, 63,
  35.                    31, 31, 63,
  36.                    39, 39, 63,
  37.                    47, 47, 63,
  38.                    55, 55, 63,
  39.                    63, 63, 63,
  40.                    55, 55, 63,
  41.                    47, 47, 63,
  42.                    39, 39, 63,
  43.                    31, 31, 63,
  44.                    23, 23, 63,
  45.                    15, 15, 63,
  46.                     7,  7, 63  );
  47.  
  48.  
  49. Type  OneChar = Array [1..CharLength] of Byte;
  50.  
  51. Var   CharSet:  Array [1..NumChars] of OneChar;
  52.       Locs:     Array [1..NumCycles] of Integer;
  53.       BarLocs:  Array [1..4] of Integer;         { Location of each bar }
  54.       CurrVert,
  55.       Count:    Integer;
  56.       Key:      Char;
  57.       MemPos:   Word;
  58.  
  59. Procedure GetChars;
  60. { Read/copy BIOS Character set into Array }
  61.   Var NumCounter,
  62.       ByteCounter,
  63.       MemCounter:       Integer;
  64.   begin
  65.       MemCounter:=0;
  66.       For NumCounter:=1 to NumChars do
  67.         For ByteCounter:=1 to CharLength do
  68.           begin
  69.  
  70. CharSet[NumCounter][ByteCounter]:=Mem[CGA_CharSet_Seg:CGA_CharSet_ofs+MemCounter];
  71.             inC(MemCounter);
  72.           end;
  73.   end;
  74.  
  75.  
  76. Procedure VideoMode ( Mode : Byte );
  77. { Set the video display mode }
  78.   begin
  79.       Asm
  80.         MOV  AH,00
  81.         MOV  AL,Mode
  82.         inT  10h
  83.       end;
  84.   end;
  85.  
  86.  
  87. Procedure SetColor ( Color, Red, Green, Blue : Byte );
  88. { Update the colour palette, to define a new colour }
  89.   begin
  90.       Port[$3C8] := Color;      { Colour number to redefine }
  91.       Port[$3C9] := Red;        { Red value of new colour   }
  92.       Port[$3C9] := Green;      { Green "   "   "    "      }
  93.       Port[$3C9] := Blue;       { Blue  "   "   "    "      }
  94.   end;
  95.  
  96.  
  97. Procedure DispVert ( Var CurrLine : Integer );
  98.   { Display next vertical 'chunk' of the Character onscreen }
  99.   Var Letter:    OneChar;
  100.       VertLine,
  101.       Count:     Integer;
  102.   begin
  103.       { Calculate pixel position of start of letter: }
  104.       Letter := CharSet[ord(DispStr[(CurrLine div 8)+1])+1];
  105.       VertLine := (CurrLine-1) Mod 8;
  106.  
  107.       { Push the Character, pixel-by-pixel, to the screen: }
  108.       For Count := 1 to 8 do
  109.         if Letter[Count] and ($80 Shr VertLine) = 0
  110.           then Mem[VGA_Segment:185*320+(Count-1)*320+319] := 0
  111.           else Mem[VGa_Segment:185*320+(Count-1)*320+319] := 181;
  112.   end;
  113.  
  114. Procedure CalcLocs;
  115. { Calculate the location of the top of bars, based on sine curve }
  116.   Var Count:    Integer;
  117.   begin
  118.       For Count := 1 to NumCycles do
  119.         Locs[Count] := Round(Radius*Sin((2*Pi/NumCycles)*Count))+Radius+1;
  120.   end;
  121.  
  122.  
  123. Procedure DoCycle;
  124. {  Display the bars on screen, by updating the palette entries to
  125.    reflect the values from the COLOUR Array, or black For blank lines }
  126.  
  127.   Label Wait,Retr,BarLoop,PrevIsLast,Continue1,Continue2,Rep1,Rep2;
  128.  
  129.   begin
  130.        Asm
  131.           { First, wait For start of vertical retrace: }
  132.           MOV   DX,3DAh
  133. Wait:     in    AL,DX
  134.           TEST  AL,08h
  135.           JZ    Wait
  136. Retr:     in    AL,DX
  137.           TEST  AL,08h
  138.           JNZ   Retr
  139.  
  140.           { then do bars: }
  141.            MOV   BX,0
  142. BarLoop:
  143.            PUSH  BX
  144.            MOV   AX,Word PTR BarLocs[BX]
  145.            MOV   BX,AX
  146.            DEC   BX
  147.            SHL   BX,1
  148.            MOV   AX,Word PTR Locs[BX]
  149.            PUSH  AX
  150.            CMP   BX,0
  151.            JE    PrevIsLast
  152.            DEC   BX
  153.            DEC   BX
  154.            MOV   AX,Word PTR Locs[BX]
  155.            JMP   Continue1
  156.  
  157. PrevIsLast:
  158.            MOV   AX,Word PTR Locs[(NumCycles-1)*2]
  159.  
  160. Continue1:
  161.            MOV   DX,03C8h
  162.            OUT   DX,AL
  163.            inC   DX
  164.            MOV   CX,15*3
  165.            MOV   AL,0
  166. Rep1:
  167.            OUT   DX,AL
  168.            LOOP  Rep1
  169.  
  170.            DEC   DX
  171.            POP   AX
  172.            OUT   DX,AL
  173.            inC   DX
  174.            MOV   CX,15*3
  175.            xor   BX,BX
  176. Rep2:
  177.            MOV   AL,Byte Ptr Colours[BX]
  178.            OUT   DX,AL
  179.            inC   BX
  180.            LOOP  Rep2
  181.  
  182.            POP   BX
  183.            inC   Word PTR BarLocs[BX]
  184.            CMP   Word PTR BarLocs[BX],NumCycles
  185.            JNG   Continue2
  186.  
  187.            MOV   Word PTR BarLocs[BX],1
  188. Continue2:
  189.            inC   BX
  190.            inC   BX
  191.            CMP   BX,8
  192.            JNE   BarLoop
  193.  
  194.         end;
  195.       end;
  196.  
  197.  
  198. begin
  199.  
  200.     VideoMode($13);             { Set video mode 320x200x256 }
  201.     Port[$3C8] := 1;            { Write palette table entry }
  202.     For Count := 1 to 180 do    { Black out the first 180 colours, }
  203.       SetColor(Count,0,0,0);    { one colour will be used per line }
  204.  
  205.     { Now colour each scan line using the given palette colour: }
  206.     MemPos := 0;
  207.     For Count := 1 to 180 do
  208.       begin
  209.         FillChar(Mem[VGA_Segment:MemPos],320,Chr(Count));
  210.         MemPos := MemPos + 320;
  211.       end;
  212.  
  213.     SetColor(181,63,63,0);
  214.     CalcLocs;
  215.     For Count := 1 to 4 do
  216.       BarLocs[Count] := Count*10;
  217.  
  218.     GetChars;
  219.     CurrVert := 1;
  220.     Repeat
  221.       DoCycle;
  222.       For Count := 1 to 8 do
  223.         Move(Mem[VGA_Segment:185*320+(Count-1)*320+1],
  224.              Mem[VGA_Segment:185*320+(Count-1)*320],319);
  225.       DispVert(CurrVert);
  226.       inC(CurrVert);
  227.       if CurrVert > Length(DispStr) * 8
  228.         then CurrVert := 1;
  229.  
  230.     Until KeyPressed;   { Repeat Until a key is pressed... }
  231.  
  232.     Key := ReadKey;     { Absorb the key pressed }
  233.     VideoMode(3);       { Reset video mode back to Textmode } end.
  234. end.
  235.